home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / xlisp2.1 / xldist01.zoo / lsp / turtle.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1990-11-09  |  3.6 KB  |  113 lines
  1. ;; TURTLE.L for PC-LISP.EXE V2.10
  2. ;; Modified for XLISP 2.0 by Tom Almy
  3. ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  4. ;;      A set of turtle graphics primitives to demonstrate PC-LISP's BIOS 
  5. ;; graphics routines. These routines are pretty self explanitory. The first
  6. ;; 5 defun's define the primitives, next are a set of routines to draw things
  7. ;; like squares, triangles etc. Try the function (GraphicsDemo). It will
  8. ;; draw Squirals, Trianglerals, etc. Note that the BIOS line drawing is really
  9. ;; slow. This is because the BIOS 'set dot/pixel' routine is used for every
  10. ;; point in a line. Using the BIOS has the advantage however of portability,
  11. ;; these routines work on virtually every MS-DOS machine. The global variable
  12. ;; *GMODE* controls the graphics resolution that will be used. It is set by 
  13. ;; default to 6 I set it to 8 or 9 for my 2000 but these routines will not
  14. ;; support the lower resolution modes. 
  15. ;;
  16. ;;                      Peter Ashwood-Smith
  17. ;;                      April 2nd, 1986 
  18. ;;
  19.  
  20.  
  21. ;; Several bugs  fixed by Tom Almy
  22. ;; The playing field is 200x200, after scaling.
  23. ;; Lfactor = ypixels/200
  24. ;; Scale = xpixels/ypixels
  25. ;; CenterX=CenterY= ypixels/2
  26.  
  27.  
  28.  
  29. (setq *GMODE* 16)                                     ; default setting
  30.  
  31. (defun TurtleGraphicsUp()           
  32.        (IF (= *GMODE* 18)
  33.            (MODE 18 0 640 480)
  34.        (MODE *GMODE*))
  35.        (cond ((= *GMODE* 6)                          ; 640x200 B&W mode
  36.           (setq CenterX 100 CenterY 100 Scale 3.2 Lfactor 1) 
  37.           (TurtleCenter))  
  38.          ((= *GMODE* 16)                 ; 640x350 Graphics
  39.           (setq CenterX 175 CenterY 175 Scale 1.83 Lfactor 1.75) 
  40.           (TurtleCenter))  
  41.          ((= *GMODE* 18)                 ; 640x480 VGA Graphics
  42.           (setq CenterX 240 CenterY 240 Scale 1.33 Lfactor 2.4) 
  43.           (TurtleCenter))  
  44.          (t (princ '|unsupported mode|))
  45.        )
  46.        (COLOR 15)
  47. )   
  48.  
  49. (defun TurtleGraphicsDown() 
  50.     (MODE 3))
  51. (defun TurtleCenter()       
  52.     (setq Lastx CenterX Lasty CenterY Heading 1.570796372))
  53. (defun TurtleRight(n)       (setq Heading (- Heading (* n 0.01745329))))
  54. (defun TurtleLeft(n)        (setq Heading (+ Heading (* n 0.01745329))))
  55. (defun TurtleGoTo(x y)      (setq Lastx (* x Lfactor) Lasty (* y Lfactor) )) 
  56.  
  57. (defun TurtleForward(n) 
  58.       (setq n (* n Lfactor) 
  59.               Newx (+ Lastx (* (cos Heading) n))
  60.         Newy (+ Lasty (* (sin Heading) n)))
  61.       (move (truncate (* Lastx Scale))
  62.             (truncate Lasty)
  63.         (truncate (* Newx Scale))
  64.         (truncate Newy))
  65.       (setq Lastx Newx Lasty Newy)
  66. )
  67.  
  68. ;
  69. ; end of Turtle Graphics primitives, start of Graphics demonstration code
  70. ; you can cut this out if you like and leave the Turtle primitives intact.
  71. ;
  72.  
  73. (defun Line_T(n)        
  74.     (TurtleForward n) (TurtleRight 180)
  75.     (TurtleForward (/ n 4)) 
  76. )
  77.     
  78. (defun Square(n)
  79.     (TurtleForward n)  (TurtleRight 90)     
  80.     (TurtleForward n)  (TurtleRight 90)     
  81.     (TurtleForward n)  (TurtleRight 90)     
  82.     (TurtleForward n)                       
  83. )
  84.  
  85. (defun Triangle(n)
  86.     (TurtleForward n)  (TurtleRight 120)
  87.     (TurtleForward n)  (TurtleRight 120)
  88.     (TurtleForward n)
  89. )
  90.  
  91. (defun Make(ObjectFunc Size star skew) 
  92.       (dotimes (dummy star)
  93.        (Apply ObjectFunc (list Size)) 
  94.        (TurtleRight skew)
  95.        )
  96. )
  97.  
  98. (defun GraphicsDemo()
  99.        (TurtleGraphicsUp) 
  100.        (Make #'Square 40 18 5) (Make #'Square 60 18 5)
  101.        (gc)                                                ; idle work
  102.        (TurtleGraphicsUp) 
  103.        (Make #'Triangle 40 18 5) (Make #'Triangle 60 18 5)
  104.        (gc)                                                 ; idle work
  105.        (TurtleGraphicsUp) 
  106.        (Make #'Line_T 80 50 10)
  107.        (gc)                                                 ; idle work
  108.        (TurtleGraphicsDown)
  109. )
  110.  
  111. (print "Try (GraphicsDemo)")
  112.  
  113.